MacHack 1998/MacHack 1998.toast/Programming Contest/Secret Solutions Folder/Problem 02 - Hower of Tanoi/Solution.p

Text File | 1998-06-15 | 6.3 KB | 252 lines | [TEXT/CWIE]

(*
Problem 02 - Hower of Tanoi

This problem is to solve a variant
of the Tower of Hanoi puzzle.  You remember the Tower of Hanoi, a board
with three pegs, one of which has N disks of size 1, 2, 3, ... N, with the
smallest disk at the top.  In the standard puzzle, the goal is to move all
of the disks from one peg to another peg, by repeatedly moving a disk from
the top of one peg to another peg without ever placing a larger disk on top
of a smaller disk.

In our Hower of Tanoi problem, the objective and the constraints are the
same, except that the disks on the first peg are initially in random order.
You can still only move a smaller disk onto a larger disk.

Your objective is output the moves required to place all the disks on
peg 3 in order with the smallest disk at the top.

Input specification

The
first line of the input file contains an integer M, M<1000, the number of
disks in the problem.  The next M lines contain the numbers 1 .. M, one
number per line, randomly ordered, where the first number is the size of
the top disk on peg 1, the second number is the size of the 2nd
disk from the top, etc.

Output specification

The output is a sequence of lines, each representing a single move,
consisting of the source peg number followed by a comma (',') followed
by the destination peg number, followed by a return character.

Sample input

2
2
1

Sample output

1,3
1,3
*)

unit Solution;

interface

// Do not modify the interface

    uses
        Types, Files;

    function HowerOfTanoi( const infile, outfile: FSSpec ): OSErr;

implementation

// Fill in your solution and then submit this folder

// Team Name: Example Solution
// 60 mintues

    function ProblemFileRead( const infile: FSSpec; var data: Handle ): OSErr; external;
    function ProblemFileWrite( const outfile: FSSpec; data: Handle ): OSErr; external;
    function ProblemReadLineFromHandle( data: Handle; line: Ptr; linelen: longint ): Boolean; external;
    function ProblemGetUInt32( var line: Ptr; var number: UInt32 ): Boolean; external;

    type
        DiskArray = array[1..$7FFFFFFF] of UInt32;
        DiskArrayPtr = ^DiskArray;
        Pole = record
            count: UInt32;
            disks: DiskArrayPtr;
        end;
        Board = array[1..3] of Pole;

    var
        result: Handle;
        poles: Board;

// Ordered - Disks are ordered if the descend along the pole

    procedure Assert( must: boolean );
    begin
        if not must then begin
            DebugStr( 'Assert failed!;sc' );
        end;
    end;

    function TopDiskSafe( pole: integer ): UInt32;
    begin
        if poles[pole].count = 0 then begin
            TopDiskSafe := $7FFFFFFF;
        end else begin
            TopDiskSafe := poles[pole].disks^[poles[pole].count];
        end;
    end;

    function TopDisk( pole: integer ): UInt32;
    begin
        Assert( poles[pole].count <> 0 );
        TopDisk := TopDiskSafe( pole );
    end;

    procedure MoveDisk( frompole, topole: integer );
        var
            s: string[10];
            junk: OSErr;
    begin
        Assert( frompole <> topole );
        Assert( TopDisk( frompole ) < TopDiskSafe( topole ) );
        Inc(poles[topole].count);
        poles[topole].disks^[poles[topole].count] := TopDisk( frompole );
        Dec(poles[frompole].count);
        s := 'x,yz';
        s[1] := chr(ord('0')+frompole);
        s[3] := chr(ord('0')+topole);
        s[4] := chr(13);
        junk := PtrAndHand( @s[1], result, length(s) );
    end;

    function Otherpole( frompole, topole: integer ): integer;
    begin
        Assert( frompole <> topole );
        Otherpole := 6 - frompole - topole;
    end;

    procedure MoveDisks( move: longint; frompole, topole: integer );
    // move 'move' disks from frompole to topole
    // 'move' disks must be in assending order and all must be less than both other poles
    begin
        Assert( frompole <> topole );
        Assert( move >= 0 );
        if move = 0 then begin
        end else if move = 1 then begin
            MoveDisk( frompole, topole );
        end else begin
            MoveDisks( move - 1, frompole, Otherpole( frompole, topole ) );
            MoveDisk( frompole, topole );
            MoveDisks( move - 1, Otherpole( frompole, topole ), topole );
        end;
    end;

    function FindPosition( pole: integer; disk: UInt32 ): UInt32;
        var
            i: UInt32;
    begin
        i := 1;
        while i <= poles[pole].count do begin
            if disk > poles[pole].disks^[i] then begin
                leave;
            end;
            Inc(i);
        end;
        FindPosition := i;
    end;

    procedure SortDisks;
    // Sort disks on disk 2 and 3 that are less than TopDisk( 1 ) on to disk 3
        var
            pos: UInt32;
            lessthan: UInt32;
            tomove: UInt32;
    begin
        lessthan := TopDiskSafe( 1 );
        while (poles[2].count <> 0) & (TopDisk( 2 ) < lessthan) do begin
            pos := FindPosition( 3, TopDisk( 2 ) );
            tomove := poles[3].count - pos + 1;
            MoveDisks( tomove, 3, 1 );
            MoveDisk( 2, 3 );
            MoveDisks( tomove, 1, 3 );
        end;
    end;

    procedure SolveDisks;
    begin
        // Invariant, pole 2 & 3 are ordered.
        // Objective is to empty pole 1.
        while poles[1].count <> 0 do begin
            if TopDisk( 1 ) < TopDiskSafe( 3 ) then begin
                MoveDisk( 1, 3 );
            end else if TopDisk( 1 ) < TopDiskSafe( 2 ) then begin
                MoveDisk( 1, 2 );
            end else begin
                SortDisks;
                MoveDisk( 1, 2 );
            end;
        end;
        SortDisks;
    end;

    function HowerOfTanoi( const infile, outfile: FSSpec ): OSErr;
        var
            err: OSErr;
            data: Handle;
            linep: Ptr;
            line: packed array[0..256] of char;
            disk_count, disk: UInt32;
            i: longint;
    begin
        err := ProblemFileRead( infile, data );
        if err = noErr then begin
            linep := @line;
            if not ProblemReadLineFromHandle( data, @line, 255 ) | not ProblemGetUInt32( linep, disk_count ) then begin
                err := -1;
            end;
            if err = noErr then begin
                for i := 1 to 3 do begin
                    poles[i].count := 0;
                    poles[i].disks := DiskArrayPtr(NewPtr(disk_count * SizeOf(UInt32)));
                    if err = noErr then begin
                        err := MemError;
                    end;
                end;
                result := NewHandle( 0 );
                if err = noErr then begin
                    err := MemError;
                end;

                if err = noErr then begin
                    poles[1].count := disk_count;
                    for i := 1 to disk_count do begin
                        linep := @line;
                        if not ProblemReadLineFromHandle( data, @line, 255 ) | not ProblemGetUInt32( linep, disk ) then begin
                            err := -1;
                        end;
                        poles[1].disks^[disk_count-i+1] := disk;
                    end;
                end;

                if err = noErr then begin
                    SolveDisks;
                end;

                for i := 1 to 3 do begin
                    if poles[i].disks <> nil then begin
                        DisposePtr( Ptr( poles[1].disks ) );
                    end;
                end;
                if err = noErr then begin
                    err := ProblemFileWrite( outfile, result );
                end;
                DisposeHandle( result );
            end;
            DisposeHandle( data );
        end;
        HowerOfTanoi := err;
    end;

end.